COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	  ce fichier teste la nouvelle fonction  DISPLAY 
C00005 00003	 Un jouli test : TTYTEST testant les fonctions de typ TTYxxx 
C00007 00004	 Fonctions de type DPYxxx 
C00010 00005	 Jeu de la vie de J. H. CONWAY  qui teste les DPYxxx functions 
C00014 ENDMK
C⊗;
 ; ce fichier teste la nouvelle fonction  DISPLAY ;

(DE TTYS (X Y S)
    ; edite la chaine S sur un ecran en TTY DM mode ;
    ; en position : Xieme ligne Yieme colonne ;
    (DISPLAY (APPEND [\177 \14 (LOGXOR \140 Y) (LOGXOR \140 X)]
		   (MAPCAR (MAKLIST S) 'CASCII)))))

(DE TTYCLEAR ()
	; efface tout l'ecran ;
	(DISPLAY [\177 \36]))


(DE TTYBOLDS (X Y S)
	; edite une chaine en BOLD face (i.e. en clignottant) ;
	; en position X ligne y colonne ;
	(DISPLAY
	   (APPEND [\177 \17 \177 \14 (LOGXOR \140 Y) (LOGXOR \140 X)]
		   (MAPCAR (MAKLIST S) 'CASCII)
		   [\177 \30])))

(DE TTYBLINKS (X Y S)
	; edite une chaine en BLINK i.e. en double brillance ;
	; en position X ligne Y colonne ;
	(DISPLAY
	   (APPEND [\177 \16 \177 \14 (LOGXOR \140 Y) (LOGXOR \140 X)]
	           (MAPCAR (MAKLIST S) 'CASCII))))

(DE TTYCURSOR (X Y)
	; positionne le curseur en X et Y ;
	(PPIOT 8 (+ (STATUS 42 1)
		    (LOC (LOGOR (LOGSHIFT X 18) Y)))))))))

(DE TTYROLLON ()
	; reactive le ROLL-ON ;
	(DISPLAY [\177 \35]))

(DE TTYROLLOF ()
	; deactive le ROLL ;
	(DISPLAY [\177 \30])))

(DE TTYNBIN ()
	; lecture sur la TTY d'un nb ;
	(WHILE (OR (LZP (SETQ N (- (TYI) \60)))
		   (GT N 9)))
	(WHILE (GE \71 (SETQ char (TYI)) \60)
	   (SETQ N (+ (* N 10) (- char \60))))
	N))
; Un jouli test : TTYTEST testant les fonctions de typ TTYxxx ;

(DE TTYTEST ()
	; Ca teste un peu tout ca ... ;
	(PPIOT 0 1) ; selection de la page 1 ;
	(TTYCLEAR)
	(DO ((LIG 3 (INCR LIG)) (COL 0 (INCR COL)))
	    ((EQ LIG 15))
	   (TTYS LIG COL " Zoummmm"))
	(DO ((LIG 20 (DECR LIG)) (COL 30 (SETQ COL (+ COL 3))))
	    ((EQ LIG 3))
	   (TTYS LIG COL " Zammmmm"))
	(DO ((LIG 20 (DECR LIG)))
	    ((LT LIG 5))
	     (TTYS LIG 23 "Ha Ha Ha"))
	(TTYS 22 0 "Tape n'inporte quel caractere.")
	(TYI) ; attente commande operateur ;
	(PPIOT 0 2) ; selection dela 2eme page ;
	(TTYCLEAR)
	(ESCAPE &ASUIVRE
          (REPEAT 2500
	   (AND (TYS) (&ASUIVRE (TYI)))
 	   (TTYS 
		(+ 3 (FIX (* (RANDOM) 19))) 
		(FIX (* (RANDOM) 78))
		(ASCII (+ 5 (FIX (* (RANDOM) 100)))))))
	(ESCAPE &ASUIVRE
	  (REPEAT 1500
	   (AND (TYS) (&ASUIVRE (TYI)))
	   (TTYS
		(+ 3 (FIX (* (RANDOM) 19)))
		(FIX (* (RANDOM) 78))
		" ")))
	(PPIOT 1 1) ; repasse en page 1 ;
	(TTYS 22 0 "Tape n'importe quel caractere :")
	(TYI)
	(PPIOT 0 0) ; reselecte la page 0 ;
))))

(PRINT "Essaie donc (TTYTEST) ... ")


; Fonctions de type DPYxxx ;
; Ces fonctions permettent d'avoir un controle complet ;
; sur tout l'ecran en particulier le "line-editor" standard ;
; ainsi que le READ  VLISP ne sont plus actifs ;
;;
; Les seules fonctions disponibles sont : ;
;	TYI	qui lit 1 caract sur le clavier SANS echo ;
;	DISPLAY qui envoie une suite de code internes a l'ecran ;
;;

(DE DPYINIT ()
  ; passe en mode DPYxxx, i.e. efface l'ecran ... ;
  ; pour en sortir faire (RESET T) qui restaure tout ;
  ; en gardant toutefois toutes ls anciennes DE DF ... ;
  (CALLI \-10 1) (DISPLAY '(\177 \36))))

(DE DPYS (XCURSOR YCURSOR MSG)
    ; edite la chaine MSG sur un ecran en DPYxxx mode ;
    ; en position : Xieme ligne Yieme colonne ;
    (DISPLAY (APPEND [\177 \14 (LOGXOR \140 Y) (LOGXOR \140 X)]
		   (MAPCAR (MAKLIST S) 'CASCII)))))
(DE DPYRECHO ( ;; N)
   ; lit un caractere et l'echo ;
   ; suppose XCURSOR et YCURSOR globaux et contenant ;
   ; la position courante du curseur ;
   (SETQ N (TYI))
   (TTYS XCURSOR (INCR YCURSOR) (STRING (ASCII N)))
   N)


(DE DPYRNB (XCURSOR YCURSOR MSG ;; N CHAR)
   ; imprime le message MSG en XCURSOR et YCURSOR ;
   ; et lit a la suite (sur la meme ligne) un nombre decimal ;
   ; la lecture s'arrete au 1er caractere non numeric ;
   ; ca ramene le nb convertit lu ;
   (TTYS XCURSOR YCURSOR (SETQ MSG (STRING MSG)))
   (SETQ YCURSOR (PLUS YCURSOR (STRINGL MSG)))
   ; saute tous les caracteres non significatifs ;
   (WHILE (OR (LZP (SETQ N (- (DPYRECHO) \60)))
		   (GT N 9)))
   ; effectue vraiment la lecture ;
   (WHILE (GE \71 (SETQ char (DPYRECHO)) \60)
   (PRINT 'N '= N)
	   (SETQ N (+ (* N 10) (- char \60))))
   ; ramene le nb convertit ;
   N))
; Jeu de la vie de J. H. CONWAY  qui teste les DPYxxx functions ;

(DE IND (I J)
   ; calcul l'adresse de l'element I J ;
   (+ (1- I) (* (1- J) LMAX)))

(DE VISUINIT (XC YC)
   ; initialise la matrice ;
   (TTYS  (INCR XC) YC (DUPL "-" (+ (* 2 LMAX) 4)))
   (TTYS  (INCR XC) YC (CONCAT "- " (DUPL " " (* 2 LMAX)) " -"))
   (SETQ I 0)
   (WHILE (LT (INCR I) LMAX)
	(TTYS (INCR XC) YC "- ")
	(TTYS XC (+ YC (+ LMAX 2)) " -"))
   (TTYS (INCR XC) YC (CONCAT "- " (DUPL " " (* 2 LMAX)) " -"))
   (TTYS (INCR XC) YC (DUPL "- " (+ (* 2 LMAX)) " -"))))))

(DE VISUGEN (XC YC ;; I J Y)
   ; visualise en XC YC le tableau T1 ;
   (TTYS 4 60 (CONCAT "Generation : " (STRING (INCR NGEN))))
   (SETQ XC (1+ XC))
   (SETQ I 0)
   (WHILE (LT (INCR I) LMAX)
	(INCR XC)
	(SETQ Y (+ YC 2))
	(SETQ J 0)
	(WHILE (LT (INCR J) LMAX)
          (SETQ Y (+ 2 Y))
          (IF (NEQ (T1 (IND I J)) (T2 (IND I J)))
	       (TTYS XC Y (IF (=0 (T2 (IND I J))) "  " " *"))))
	(INCR Y)))))

(DE CONWAY (L ;; I J RUB)
   (SETQ RUB "                                   ")
   ; init e l'ecran ;
   (DPYINIT)  
   (SETQ NGEN 0)
   (OR (EQ (TYPEFN 'T1) ARRAY)
      (PROGN (SETQ LMAX (DPYRNB 23 0 "Taille des matrices (e.g. 13) ?"))
	(TTYS 23 0 RUB)
        (PPIOT 2 \-1000)
	(DA 'T1 (* LMAX LMAX))
	(DA 'T2 (* LMAX LMAX))))
   (OR L (SETQ L '((5 4)(6 5)(6 6)(6 7)(5 7))))
   (FILLARRAY 'T1 0)
   (FILLARRAY 'T2 0)
   (MAPC L (LAMBDA (L) (SETQA T1 (IND (CAR L)(CADR L)) 1)))
	(VISUGEN 5 20)
   (WHILE T
     (SETQ L (DPYRNB 23 0 "Encore combien (0 pour finir) ?"))
     (TTYS 23 0 RUB)
     (IF (=0 L) (RESET T) ;(DPYINIT NIL) "Voila.");
       (REPEAT L
	(SETQ I 1)
	(WHILE (LT (INCR I) (- LMAX 2))
	   (SETQ J 1)
	   (WHILE (LT (INCR J) (- LMAX 2))
		(SETQ V (PLUS
			(T1 (IND (1- I) (1- J)))
			(T1 (IND (1- I) J))
			(T1 (IND (1- I) (1+ J)))
			(T1 (IND I (1- J)))
			(T1 (IND I (1+ J)))
			(T1 (IND (1+ I) (1- J)))
			(T1 (IND (1+ I) J))
			(T1 (IND (1+ I) (1+ J)))))
		(SETQA T2 (IND I J)
		   (IF (=0 (T1 (IND I J)))
			(IF (= V 3) 1 0)
			(IF (OR (= V 2)(= V 3)) 1 0))) 
		))
	(VISUGEN 5 20)
	(MAPARRAYQ T1 (LAMBDA (X) (SETQA T1 X (T2 X)))))))
)))))


(PRINT "Essaie aussi (CONWAY).")